{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit LocalTestSession;

interface

uses
  Classes, SysUtils, TestSession, TestCore, Profile, Forms, TestPlayer, Controls,
  VisualUtils, MiscUtils, SecureRandom;

type
  TFinishWorkEvent = procedure(const PartRight: Double) of object;

procedure OpenTestSession(var Test: TTest; var Profile: TProfile;
  const OnFinishWork: TFinishWorkEvent; Host: TWinControl);

implementation

resourcestring
  STestError = 'Error in the test: %s';
  SNoQuestionsAvailable = 'No questions are available.';

type
  TEvaluatedAnswer = class
  private
    FResponse: TResponse;
    FPartRight: Single;
  public
    constructor Create(Response: TResponse; PartRight: Single);
    destructor Destroy; override;
  end;
  TEvaluatedAnswerList = TGenericObjectList<TEvaluatedAnswer>;

  TPlanItem = class
  private
    FSourceQuestionIndex: Integer;
    FAlterantList: TAlterantList;
    FWeight: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    property AlterantList: TAlterantList read FAlterantList;
    property SourceQuestionIndex: Integer read FSourceQuestionIndex;
    property Weight: Integer read FWeight;
  end;
  TPlanItemList = TGenericObjectList<TPlanItem>;

  TPlan = class
  private
    FItems: TPlanItemList;
    FTotalWeight: Int64;
    function GetItemCount: Integer;
    function GetItems(Index: Integer): TPlanItem;
  public
    constructor Create;
    destructor Destroy; override;
    class function Generate(Test: TTest; Profile: TProfile): TPlan;

    property ItemCount: Integer read GetItemCount;
    property Items[Index: Integer]: TPlanItem read GetItems;
    property TotalWeight: Int64 read FTotalWeight;
  end;

  TLocalTestSessionConnector = class(TTestSessionConnector)
  private
    FTest: TTest;
    FProfile: TProfile;
    FPlan: TPlan;
    FAnswers: TEvaluatedAnswerList;
    FOnFinishWork: TFinishWorkEvent;
    FAllQuestions: TQuestionList;
    function GetProducedQuestion(Index: Integer): TQuestion;
    function GetWeightRight: Double;
    function GenerateSessionOutcome: TSessionOutcome;
  public
    constructor Create(var Test: TTest; var Profile: TProfile;
      const OnFinishWork: TFinishWorkEvent);
    destructor Destroy; override;
    function GetSession: TTestSession; override;
    procedure GetQuestions(Questions: TQuestionList); override;
    function FinishWork: TSessionResult; override;
    procedure SetResponse(Index: Integer; Response: TResponse;
      out PartRight, PartRightTotal: Single); override;
  end;

procedure OpenTestSession(var Test: TTest; var Profile: TProfile;
  const OnFinishWork: TFinishWorkEvent; Host: TWinControl);
var
  Connector: TLocalTestSessionConnector;
  f: TTestPlayerFrame;
begin
  Connector := TLocalTestSessionConnector.Create(Test, Profile, OnFinishWork); {
    Connector takes ownership of Test and Profile, they are set to nil upon return. }
  try
    f := TTestPlayerFrame.Create(Host);
    try
      f.Parent := Host;
      f.SetUp(TTestSessionConnector(Connector));
    except
      f.Free;
      raise;
    end;
  finally
    Connector.Free;
  end;
end;

{ TEvaluatedAnswer }

constructor TEvaluatedAnswer.Create(Response: TResponse;
  PartRight: Single);
begin
  inherited Create;
  FResponse := Response.Clone;
  FPartRight := PartRight;
end;

destructor TEvaluatedAnswer.Destroy;
begin
  FreeAndNil(FResponse);
  inherited;
end;

{ TPlanItem }

constructor TPlanItem.Create;
begin
  inherited;
  FAlterantList := TAlterantList.Create;
end;

destructor TPlanItem.Destroy;
begin
  FreeAndNil(FAlterantList);
  inherited;
end;

{ TPlan }

constructor TPlan.Create;
begin
  inherited;
  FItems := TPlanItemList.Create;
end;

destructor TPlan.Destroy;
begin
  FreeAndNil(FItems);
  inherited;
end;

class function TPlan.Generate(Test: TTest; Profile: TProfile): TPlan;
var
  i: Integer;
  AllQuestions: TQuestionList;

  procedure AddQuestion(SourceQuestionIndex: Integer);
  { Produces new question from the source question specified by SourceQuestionIndex
    and adds it to the plan. }
  var
    SourceQuestion, ProducedQuestion: TQuestion;
    Item: TPlanItem;
  begin
    SourceQuestion := AllQuestions[SourceQuestionIndex];

    try
      Item := TPlanItem.Create;
      Result.FItems.AddSafely(Item);

      Item.FSourceQuestionIndex := SourceQuestionIndex;
      ProducedQuestion := SourceQuestion.Produce(Item.FAlterantList);
      try
        Profile.ModifierList.Apply(ProducedQuestion, Item.FAlterantList);
        Item.FWeight := ProducedQuestion.Weight;
      finally
        ProducedQuestion.Free;
      end;
    except on E: Exception do
      raise Exception.CreateFmt(STestError, [E.Message]);
    end;
  end;

  procedure ChooseFromSection(Section: TSection);
  var
    QuestionIndices: TIntegerList; { Section's question indices not yet in the plan }
    i, QuestionsRemaining, p: Integer;
    Question: TQuestion;
  begin
    { choose from this section }
    QuestionIndices := TIntegerList.Create;
    try
      for i := 0 to Section.QuestionCount-1 do
        QuestionIndices.Add(i);

      QuestionsRemaining := Profile.Configuration.QuestionsPerSection;
      while (QuestionsRemaining > 0) and (QuestionIndices.Count > 0) do
      begin
        p := SecureRandomInteger(QuestionIndices.Count);
        Question := Section.Questions[QuestionIndices[p]];
        QuestionIndices.Delete(p);
        AddQuestion(AllQuestions.IndexOf(Question));
        Dec(QuestionsRemaining);
      end;
    finally
      QuestionIndices.Free;
    end;

    { choose from subsections }
    for i := 0 to Section.SectionCount-1 do
      ChooseFromSection(Section.Sections[i]);
  end;

begin
  Result := TPlan.Create;
  try
    AllQuestions := TQuestionList.Create(FALSE);
    try
      Test.Section.GetCompleteQuestionList(AllQuestions);

      if Profile.Configuration.QuestionsPerSection > 0 then
        ChooseFromSection(Test.Section)
      else
      begin
        for i := 0 to AllQuestions.Count-1 do
          AddQuestion(i);
      end;

      if Result.ItemCount = 0 then
        raise Exception.Create(SNoQuestionsAvailable);

      if Profile.Configuration.ShuffleQuestions then
        ShuffleList(Result.FItems, SecureRandomInteger);

      for i := 0 to Result.ItemCount-1 do
        Inc(Result.FTotalWeight, Result.Items[i].Weight);

      Assert( Result.FTotalWeight > 0 );
      if Result.FTotalWeight > MaxInt then
        raise Exception.CreateFmt('Total question weight is too big (%d).', [Result.FTotalWeight]);
    finally
      AllQuestions.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TPlan.GetItemCount: Integer;
begin
  Result := FItems.Count;
end;

function TPlan.GetItems(Index: Integer): TPlanItem;
begin
  Assert( Index >= 0 );
  Assert( Index < ItemCount );
  Result := FItems[Index];
end;

{ TLocalTestSessionConnector }

constructor TLocalTestSessionConnector.Create(var Test: TTest;
  var Profile: TProfile; const OnFinishWork: TFinishWorkEvent);
begin
  inherited Create;
  FOnFinishWork := OnFinishWork;
  FTest := Test;
  Test := nil;
  FProfile := Profile;
  Profile := nil;

  FAllQuestions := TQuestionList.Create(FALSE);
  FTest.Section.GetCompleteQuestionList(FAllQuestions);

  FPlan := TPlan.Generate(FTest, FProfile);

  FAnswers := TEvaluatedAnswerList.Create;
  FAnswers.Count := FPlan.ItemCount;
end;

destructor TLocalTestSessionConnector.Destroy;
begin
  FreeAndNil(FAllQuestions);
  FreeAndNil(FTest);
  FreeAndNil(FProfile);
  FreeAndNil(FPlan);
  FreeAndNil(FAnswers);
  inherited;
end;

procedure TLocalTestSessionConnector.SetResponse(Index: Integer; Response: TResponse;
  out PartRight, PartRightTotal: Single);
var
  Question: TQuestion;
  r: Single;
begin
  Question := GetProducedQuestion(Index);
  try
    try
      r := Question.Evaluate(Response);
    except on E: Exception do
      raise Exception.CreateFmt(STestError, [E.Message]);
    end;
  finally
    Question.Free;
  end;
  FAnswers[Index] := TEvaluatedAnswer.Create(Response, r);

  if FProfile.Configuration.InstantAnswerCorrectness then
    PartRight := r
  else
    PartRight := -1;

  if FProfile.Configuration.InstantTotalPercentCorrect then
    PartRightTotal := GetWeightRight / FPlan.TotalWeight
  else
    PartRightTotal := -1;
end;

function TLocalTestSessionConnector.FinishWork: TSessionResult;
var
  SessionOutcome: TSessionOutcome;
  WeightTotal: Int64;
begin
  Result := nil;
  try
    SessionOutcome := GenerateSessionOutcome;
    try
      if Assigned(FOnFinishWork) then
      begin
        WeightTotal := SessionOutcome.WeightTotal;
        Assert( WeightTotal > 0 );
        FOnFinishWork(SessionOutcome.WeightRight / WeightTotal);
      end;

      if FProfile.ResultPolicy.ResultsAvailable then
        Result := TSessionResult.Generate(FTest, FProfile, SessionOutcome);
    finally
      SessionOutcome.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TLocalTestSessionConnector.GenerateSessionOutcome: TSessionOutcome;
var
  i: Integer;
  Item: TPlanItem;
  Slot: TSessionSlot;
  Question: TQuestion;
begin
  Result := TSessionOutcome.Create;
  try
    for i := 0 to FPlan.ItemCount-1 do
    begin
      Item := FPlan.Items[i];
      Slot := TSessionSlot.Create;
      Result.Add(Slot);

      Slot.SourceQuestionIndex := Item.SourceQuestionIndex;
      Slot.Weight := Item.Weight;
      if FAnswers[i] = nil then
        Slot.PartRight := -1
      else
      begin
        Slot.PartRight := FAnswers[i].FPartRight;
        Slot.UserAnswer := FAnswers[i].FResponse.Clone;
      end;

      Question := GetProducedQuestion(i);
      try
        Slot.RightAnswer := Question.Response.Clone;
        Question.Filter;
        Slot.EmptyAnswer := Question.Response.Clone;
      finally
        Question.Free;
      end;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TLocalTestSessionConnector.GetProducedQuestion(
  Index: Integer): TQuestion;
begin
  Result := FAllQuestions[FPlan.Items[Index].SourceQuestionIndex].Clone;
  try
    FPlan.Items[Index].AlterantList.Apply(Result);
  except
    Result.Free;
    raise;
  end;
end;

procedure TLocalTestSessionConnector.GetQuestions(Questions: TQuestionList);
var
  i: Integer;
  Question: TQuestion;
begin
  for i := 0 to FPlan.ItemCount-1 do
  begin
    Question := GetProducedQuestion(i);
    try
      Question.Filter;
      if not FProfile.Configuration.WeightCues then
        Question.Weight := 1;

      Questions.Add(Question);
    except
      Question.Free;
      raise;
    end;
  end;
end;

function TLocalTestSessionConnector.GetSession: TTestSession;
var
  i: Integer;
  Item: TTestSessionItem;
begin
  Result := TTestSession.Create;
  try
    Result.EditableAnswers := FProfile.Configuration.EditableAnswers;
    Result.BrowsableQuestions := FProfile.Configuration.BrowsableQuestions;

    if FProfile.Configuration.DurationMinutes = 0 then
      Result.TimeTotal := -1
    else
      Result.TimeTotal := FProfile.Configuration.DurationMinutes / (24*60);

    if FProfile.Configuration.InstantTotalPercentCorrect then
      Result.PartRight := 0
    else
      Result.PartRight := -1;

    for i := 0 to FPlan.ItemCount-1 do
    begin
      Item := TTestSessionItem.Create;
      Result.Add(Item);
      Item.PartRight := -1;
    end;
  except
    Result.Free;
    raise;
  end;
end;

function TLocalTestSessionConnector.GetWeightRight: Double;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to FPlan.ItemCount-1 do
    if FAnswers[i] <> nil then
      Result := Result + FAnswers[i].FPartRight * FPlan.Items[i].Weight;
end;

end.

